home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / NETWORK.SWG / 0009_Netware Bindary Object.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  5KB  |  178 lines
  1. {
  2. Robert C. Kohlbus
  3.  
  4.         I'm trying to compile and run a program that I wrote, with BP70
  5. 'real' mode, in 'Protected Mode'.  This program uses Interrupt 21h
  6. functions B80Xh and E3h, the Novell Netware ones.  The program worked fine
  7. in 'real' mode, but gives incorrect information in 'Protected Mode'.  After
  8. calling Borland, they said it was because the DPMI overlay file didn't know
  9. how to handle the interrupts I was trying to access.  They suggested that I
  10. look at a file from their BBS called READWRTE.PAS that shows how to handle
  11. interrupts in a 'Protected Mode' program.  Basically this example file, just
  12. interrupt 31h (Simulate Real Mode Interrupt).  My problem is that my program
  13. continues to hang up, even after following their example.  Below is a sample
  14. part of my program.  If anyone can lend a hand, I would be in their debt.
  15. }
  16.  
  17. Program Getid;      { Get unique Id for Novell Netware Bindery Object }
  18.  
  19. uses
  20.   Dos, Crt, WinApi;
  21.  
  22. type
  23.   TDPMIRegs = record
  24.     edi, esi, ebp, reserved, ebx, edx, ecx, eax: LongInt;
  25.     flags, es, ds, fs, gs, ip, cs, sp, ss : Word;
  26.   end;
  27.  
  28. var
  29.   Hexid : string;
  30.   R: TDPMIRegs;
  31.  
  32.   RequestBuffer : record
  33.       PacketLength  : integer;
  34.       functionval   : byte;
  35.       ObjectType    : packed array [1..2] of byte;
  36.       NameLength    : byte;
  37.       ObjectName    : packed array [1..47] of char;
  38.   end;
  39.  
  40.   ReplyBuffer  : record
  41.       ReturnLength  : integer;
  42.       UniqueID1  : packed array [1..2] of byte;
  43.       UniqueID2  : packed array [1..2] of byte;
  44.       ObjectType : packed array [1..2] of byte;
  45.       ObjectName : packed array [1..48] of byte;
  46.   end;
  47.  
  48.  
  49. function DPMIRealInt(IntNo, CopyWords: Word; var R: TDPMIRegs): Boolean; assembler;
  50. asm
  51.   mov ax, 0300h
  52.   mov bx, IntNo
  53.   mov cx, CopyWords
  54.   les di, R
  55.   int 31h
  56.   jc  @error
  57.   mov ax, 1
  58.   jmp @done
  59. @error:
  60.   xor ax, ax
  61.   @Done:
  62. end;
  63.  
  64. function LongFromBytes(HighByte, LowByte: Byte): LongInt; assembler;
  65. asm
  66.   mov dx, 0
  67.   mov ah, HighByte
  68.   mov al, LowByte
  69. end;
  70.  
  71. function LongFromWord(LoWord: Word): LongInt; assembler;
  72. asm
  73.   mov dx, 0
  74.   mov ax, LoWord;
  75. end;
  76.  
  77. function RealToProt(P: Pointer; Size: Word; var Sel: Word): Pointer;
  78. begin
  79.   SetSelectorBase(Sel, LongInt(HiWord(LongInt(P))) Shl 4 + LoWord(LongInt(P)));
  80.   SetSelectorLimit(Sel, Size);
  81.   RealToProt := Ptr(Sel, 0);
  82. end;
  83.  
  84.  
  85. procedure GetObjectID(Name : string; ObjType : Word);
  86. const
  87.     HEXDIGITS : Array [0..15] of char = '0123456789ABCDEF';
  88.  
  89. var Reg : Registers;
  90.     i : integer;
  91.     Hex_ID, S : string;
  92.     ErrorCode : word;
  93.     ObjectId  : array[1..8] of byte;
  94.  
  95.  
  96. begin
  97.   with RequestBuffer do
  98.   begin
  99.      PacketLength  := 52;
  100.      FunctionVal   := $35;
  101.      ObjectType[1] := $0;
  102.      ObjectType[2] := ObjType;
  103.      NameLength    := length(Name);
  104.      for i := 1 to length(Name) do
  105.        ObjectName[i] := Name[i];
  106.   end;
  107.   ReplyBuffer.ReturnLength := 55;
  108.  
  109.   { Original Code that worked in Real Mode }
  110. {
  111.   Reg.ah := $E3;
  112.   Reg.ds := seg(RequestBuffer);
  113.   Reg.si := ofs(RequestBuffer);
  114.   Reg.es := seg(ReplyBuffer);
  115.   Reg.di := ofs(ReplyBuffer);
  116.  
  117.   MsDos(Reg);
  118. }
  119.  
  120.   { New Code From Borland Example }
  121.   FillChar(R, SizeOf(TDPMIRegs), #0);
  122.   R.Eax := $E3;
  123.   R.ds  := seg(RequestBuffer);
  124.   R.Esi := LongFromWord(ord(RequestBuffer));
  125.   R.es  := seg(ReplyBuffer);
  126.   R.Edi := LongFromWord(ord(ReplyBuffer));
  127.   DPMIRealInt($21, 0, R);
  128.  
  129. {
  130.   S := 'None';
  131.   Errorcode := Reg.al;
  132.   if Errorcode = $96 then S := 'Server out of memory';
  133.   if Errorcode = $EF then S := 'Invalid name';
  134.   if Errorcode = $F0 then S := 'Wildcard not allowed';
  135.   if Errorcode = $FC then S := 'No such object *'+QueueName+'*';
  136.   if Errorcode = $FE then S := 'Server bindery locked';
  137.   if Errorcode = $FF then S := 'Bindery failure';
  138.   S := 'Error : '+ S;
  139.   Writeln(S);
  140. }
  141.   Hex_ID := '';
  142.  
  143.   Hex_ID := hexdigits[ReplyBuffer.UniqueID1[1] shr 4];
  144.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID1[1] and $0F];
  145.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID1[2] shr 4];
  146.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID1[2] and $0F];
  147.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[1] shr 4];
  148.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[1] and $0F];
  149.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[2] shr 4];
  150.   Hex_ID := Hex_ID + hexdigits[ReplyBuffer.UniqueID2[2] and $0F];
  151.   while Hex_ID[1] = '0' do
  152.       Hex_ID := copy(Hex_ID,2,length(Hex_ID));
  153.  
  154.   Hexid := Hex_ID;
  155.  
  156. end;
  157.  
  158. begin
  159.    Hexid := '';
  160.    ClrScr;
  161.  
  162.    { Get An Objects Id
  163.      Parameters (2)  Object Name, Object Type
  164.      Object Name = String[8];
  165.      Object Type = Word;
  166.           1  User
  167.           2  User Group
  168.           3  Print Queue
  169.           4  File Server
  170.           5  Job Server
  171.           6  Gateway
  172.           7  Print Server
  173.    }
  174.    GetObjectID('BUSINESS', 3);     { Get Print Queue's ID }
  175.    Writeln('Hexid for BUSINESS is ',hexid);
  176.  
  177. end.
  178.